home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 11 / FM Towns Free Software Collection 11.iso / fb386 / tool / move / move.bas next >
BASIC Source File  |  1995-06-24  |  9KB  |  323 lines
  1. 10 '   綺麗にＭＯＶＥ V1.1
  2. 20 '
  3. 30 '  Produced By K.Fujita
  4. 40 '
  5. 50 '     1995.6.24
  6. 60 '
  7. 100 'CLEAR ,,,526000:DIM A(65529),B(65529),C(200):'@H
  8. 110 CLEAR ,,,258000:DIM A(32000),B(32000),C(200)
  9. 120 DIM NO1(19),NO2(19),NO3(19),FR%(19)
  10. 130 CLS:FILES:PRINT:COLOR 7 
  11. 140 INPUT"MOVEするﾌﾟﾛｸﾞﾗﾑﾌｧｲﾙ名  ? ",MNA$
  12. 150 INPUT"複数の移動指定をしますか？ (する時は Y ｷｰ) ",D$::IF D$="Y" OR D$="y" THEN 500
  13. 160 INPUT"移動元の先頭行番号は？　",NO1
  14. 170 INPUT"移動元の終了行番号は？　",NO2:IF NO2<NO1 THEN PRINT :GOTO 160
  15. 180 INPUT"移動先の先頭行番号は？　",NO3
  16. 190 INPUT"行番号のSTEP数 ? ",ST
  17. 200 INPUT"LISTを出しますか ? (出す時は Y ｷｰ) ",D$:IF D$="Y" OR D$="y" THEN P=1
  18. 210 INPUT"RENUMしますか ? (RENUMする時は Y ｷｰ) ",D$:IF D$<>"Y" AND D$<>"y" THEN 1040
  19. 220 RE=1
  20. 230 INPUT"RENUM後の先頭行番号 ? ",NOO
  21. 240 GOTO 1040
  22. 250 '
  23. 500 '@5H
  24. 510 T=0:SPF%=1
  25. 520 PRINT:PRINT T+1;"番目の指定"
  26. 530 INPUT"移動元の先頭行番号は？　",NO1(T)
  27. 540 INPUT"移動元の終了行番号は？　",NO2(T):IF NO2(T)<NO1(T) THEN 520
  28. 550 INPUT"移動先の先頭行番号は？　",NO3(T)
  29. 560 IF T=0 THEN 630
  30. 570 TT=0
  31. 580 IF NO1(T)>=NO1(TT) AND NO1(T)<=NO2(TT) THEN 810
  32. 590 IF NO2(T)>=NO1(TT) AND NO2(T)<=NO2(TT) THEN 840
  33. 600 IF NO1(TT)>NO1(T) AND NO2(TT)<NO2(T) THEN 870
  34. 610 TT=TT+1:IF TT<T THEN 580
  35. 620 IF T=19 THEN 680
  36. 630 PRINT 
  37. 640 PRINT"移動範囲の指定を続けますか？"
  38. 650 PRINT"後";19-T;"箇所指定できます。"
  39. 660 INPUT"（指定する時はＹキー） ",D$
  40. 670 IF D$="Y" OR D$="y" THEN T=T+1:GOTO 520
  41. 680 RT%=T:PRINT 
  42. 690 INPUT"行番号のSTEP数 ? ",ST
  43. 700 INPUT"LISTを出しますか ? (出す時は Y ｷｰ) ",D$:IF D$="Y" OR D$="y" THEN P=1
  44. 710 RE=1
  45. 720 INPUT"RENUM後の先頭行番号 ? ",NOO
  46. 730 GOTO 2010
  47. 740 '
  48. 800 '@H
  49. 810 COLOR 6:BEEP
  50. 820 PRINT "移動元の先頭行番号は";TT+1;"番目の範囲指定に含まれています"
  51. 830 COLOR 7:GOTO 520
  52. 840 COLOR 6:BEEP
  53. 850 PRINT "移動元の終了行番号は";TT+1;"番目の範囲指定に含まれています"
  54. 860 COLOR 7:GOTO 520
  55. 870 COLOR 6:BEEP
  56. 880 PRINT TT+1;"番目で指定した範囲が含まれています"
  57. 890 COLOR 7:GOTO 520
  58. 1000 '@K
  59. 1010 '****  ﾒｲﾝ ﾌﾟﾛｸﾞﾗﾑ  ****
  60. 1020 '--- ｲﾄﾞｳﾃﾞｰﾀ ﾁｭｳｼｭﾂ ---
  61. 1030 '
  62. 1040 OPEN"I",#1,MNA$
  63. 1050 OPEN"O",#2,"ﾀﾞﾐｰ1":OPEN"O",#3,"ﾀﾞﾐｰ2"
  64. 1060 IF EOF(1) THEN 1200
  65. 1070 LINE INPUT#1,DAT$
  66. 1080 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  67. 1090 IF NO>=NO1 AND NO<=NO2 THEN PRINT#2,DAT$:GOTO 1060
  68. 1100 PRINT#3,DAT$:GOTO 1060
  69. 1200 '@H
  70. 1210 CLOSE:TG=0:TP=0:FR=0
  71. 1220 OPEN"I",#1,"ﾀﾞﾐｰ2":OPEN"O",#2,"ﾀﾞﾐｰ":OPEN"I",#3,"ﾀﾞﾐｰ1"
  72. 1230 IF RE=0 THEN 1500
  73. 1240 IF EOF(1) THEN 1410
  74. 1250 LINE INPUT#1,DAT$
  75. 1260 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  76. 1270 IF NO<NO3 OR FR=1 THEN GOSUB 4110:GOTO 1240
  77. 1280 HNO=NO:HDAT$=DAT$:CF%=2:GOSUB 4010
  78. 1290 IF EOF(3) THEN NO=HNO:DAT$=HDAT$:CF%=1:FR=1:GOSUB 4050:GOTO 1270
  79. 1300 LINE INPUT#3,DAT$
  80. 1310 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  81. 1320 GOSUB 4110:GOTO 1290
  82. 1400 '@H
  83. 1410 IF FR=1 THEN 3020 ELSE CF%=2:GOSUB 4010
  84. 1420 IF EOF(3) THEN GOSUB 4050:GOTO 3020
  85. 1430 LINE INPUT#3,DAT$
  86. 1440 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  87. 1450 GOSUB 4110:GOTO 1420
  88. 1500 '@H
  89. 1510 IF EOF(1) THEN NOO=NO3:GOTO 1410
  90. 1520 LINE INPUT#1,DAT$
  91. 1530 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  92. 1540 IF NO<NO3 OR FR=1 THEN NOO=NO:GOSUB 4230:GOTO 1510
  93. 1550 HNO=NO:HDAT$=DAT$:CF%=2:GOSUB 4010:NOO=NO3
  94. 1560 IF EOF(3) THEN NO=HNO:DAT$=HDAT$:CF%=1:FR=1:GOSUB 4050:GOTO 1600
  95. 1570 LINE INPUT#3,DAT$
  96. 1580 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  97. 1590 GOSUB 4230:GOTO 1560
  98. 1600 '@H
  99. 1610 IF NO>NOO-ST THEN 1540
  100. 1620 COLOR 2:BEEP
  101. 1630 PRINT"移動先の行番号と既存の行番号が"
  102. 1640 PRINT"重なっていますので、以後はRENUM処理します！"
  103. 1650 PRINT"           (Hit any Key)":COLOR 7
  104. 1660 GOSUB 4020
  105. 1670 GOTO 1270
  106. 1680 '
  107. 2000 '@K
  108. 2010 OPEN"I",#1,MNA$:OPEN"O",#3,"ﾀﾞﾐｰ2"
  109. 2020 IF EOF(1) THEN 2510
  110. 2030 LINE INPUT#1,DAT$
  111. 2040 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  112. 2050 T=0
  113. 2060 IF NO>=NO1(T) AND NO<=NO2(T) THEN 2110
  114. 2070 IF T<RT% THEN T=T+1:GOTO 2060
  115. 2080 PRINT#3,DAT$:GOTO 2020
  116. 2100 '@H
  117. 2110 OPEN"O",#2,"ﾀﾞﾐｰ_"+STR$(T)
  118. 2120 GOTO 2160
  119. 2130 IF EOF(1) THEN 2510
  120. 2140 LINE INPUT#1,DAT$
  121. 2150 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  122. 2160 IF NO<=NO2(T) THEN PRINT#2,DAT$:GOTO 2130
  123. 2170 CLOSE#2
  124. 2180 GOTO 2050
  125. 2190 '
  126. 2500 '@5H
  127. 2510 CLOSE:TG=0:TP=0
  128. 2520 OPEN"I",#1,"ﾀﾞﾐｰ2":OPEN"O",#2,"ﾀﾞﾐｰ"
  129. 2530 IF EOF(1) THEN 2710
  130. 2540 LINE INPUT#1,DAT$
  131. 2550 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  132. 2560 T=0
  133. 2570 IF NO>=NO3(T) AND FR%(T)=0 THEN 2600
  134. 2580 IF T<RT% THEN T=T+1:GOTO 2570
  135. 2590 GOSUB 4110:GOTO 2530
  136. 2600 HNO=NO:HDAT$=DAT$:CF%=2:GOSUB 4010
  137. 2610 OPEN"I",#3,"ﾀﾞﾐｰ_"+STR$(T)
  138. 2620 IF EOF(3) THEN NO=HNO:DAT$=HDAT$:CF%=1:FR%(T)=1:GOSUB 4050:CLOSE#3:GOTO 2580
  139. 2630 LINE INPUT#3,DAT$
  140. 2640 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  141. 2650 GOSUB 4110:GOTO 2620
  142. 2700 '@H
  143. 2710 T=0
  144. 2720 IF FR%(T)=0 THEN 2810
  145. 2730 IF T<RT% THEN T=T+1:GOTO 2720
  146. 2740 GOTO 3020
  147. 2800 '@H
  148. 2810 CF%=2:GOSUB 4010
  149. 2820 T=0
  150. 2830 IF FR%(T)=0 THEN 2860
  151. 2840 IF T<RT% THEN T=T+1:GOTO 2830
  152. 2850 GOSUB 4050:GOTO 3020
  153. 2860 OPEN"I",#3,"ﾀﾞﾐｰ_"+STR$(T)
  154. 2870 IF EOF(3) THEN CLOSE#3:GOTO 2840
  155. 2880 LINE INPUT#3,DAT$
  156. 2890 NO=VAL(LEFT$(DAT$,INSTR(DAT$," ")))
  157. 2900 GOSUB 4110:GOTO 2870
  158. 2910 '
  159. 3000 '--- ｼﾝ ﾌｧｲﾙ ｻｸｾｲ ---                '@K
  160. 3010 '
  161. 3020 CLOSE:PRINT:TG=0:TP=0:CF%=0:ERF%=0:COLOR 7
  162. 3030 INPUT "作成するﾌﾟﾛｸﾞﾗﾑﾌｧｲﾙ名 ? ",NA$:IF NA$="" THEN 3150
  163. 3040 OPEN"I",#1,"ﾀﾞﾐｰ":OPEN"O",#2,NA$
  164. 3050 IF EOF(1) THEN 3130 
  165. 3060 LINE INPUT#1,DAT$
  166. 3070 GOSUB 5000
  167. 3080 PRINT#2,MID$(STR$(B(TG)),2);" ";DAT$
  168. 3090 IF C(TP)=TG THEN GOSUB 3180:TP=TP+1
  169. 3100 IF ERFF%=1 THEN GOSUB 3300:GOTO 3120
  170. 3110 IF P=1 THEN PRINT MID$(STR$(B(TG)),2);" ";DAT$
  171. 3120 TG=TG+1:GOTO 3050
  172. 3130 '
  173. 3140 CLOSE:COLOR 7
  174. 3150 KILL"ﾀﾞﾐｰ":KILL"ﾀﾞﾐｰ2":IF SPF%=0 THEN KILL"ﾀﾞﾐｰ1":END
  175. 3160 FOR T=0 TO RT%:KILL"ﾀﾞﾐｰ_"+STR$(T):NEXT:END
  176. 3170 '
  177. 3180 IF CF%=1 THEN CF%=0:COLOR 7 ELSE CF%=1:COLOR 5
  178. 3190 RETURN
  179. 3200 '
  180. 3300 '@H エラー
  181. 3310 COLOR 2:ERFF%=0
  182. 3320 PRINT MID$(STR$(B(TG)),2);" ";DAT$
  183. 3330 COLOR 6
  184. 3340 PRINT"上記の行に存在してない行番号が使われている恐れがあります"
  185. 3350 PRINT"      Hit Any Key"
  186. 3360 D$=INKEY$:IF D$="" THEN 3360
  187. 3370 IF CF%=1 THEN COLOR 5 ELSE COLOR 7
  188. 3380 RETURN
  189. 4000 '@K
  190. 4010 COLOR 6:PRINT "ここへ移動してきます (Hit any key)":COLOR 3
  191. 4020 D$=INKEY$:IF D$="" THEN 4020
  192. 4030 RETURN
  193. 4040 '
  194. 4050 COLOR 6:PRINT "ここまでです (Hit any key)":COLOR 7
  195. 4060 GOTO 4020
  196. 4100 '@H
  197. 4110 IF INSTR(DAT$,"'@H") THEN NO1=100:GOTO 4180
  198. 4120 IF INSTR(DAT$,"'@2H") THEN NO1=200:GOTO 4180
  199. 4130 IF INSTR(DAT$,"'@5H") THEN NO1=500:GOTO 4180
  200. 4140 IF INSTR(DAT$,"'@K") THEN NO1=1000:GOTO 4180
  201. 4150 IF INSTR(DAT$,"'@5K") THEN NO1=5000:GOTO 4180
  202. 4160 IF INSTR(DAT$,"'@M") THEN NO1=10000:GOTO 4180
  203. 4170 GOTO 4240
  204. 4180 IF (NOO MOD NO1)=0 THEN 4200
  205. 4190 NOO=(NOO\NO1+1)*NO1
  206. 4200 C(TP)=TG:TP=TP+1
  207. 4210 IF CF%=1 THEN CF%=0:COLOR 7:GOTO 4240
  208. 4220 IF CF%=0 THEN CF%=1:COLOR 5:GOTO 4240
  209. 4230 IF CF%=2 THEN COLOR 3
  210. 4240 A(NO)=NOO:PRINT NO;TAB(7)"-->";TAB(12);NOO:B(TG)=NOO:NOO=NOO+ST:TG=TG+1
  211. 4250 PRINT#2,MID$(DAT$,LEN(STR$(NO))+1)
  212. 4260 RETURN
  213. 4270 '
  214. 4500 '@5H
  215. 4510 W=F+L
  216. 4520 A$=MID$(DAT$,W)
  217. 4530 B=VAL(A$)
  218. 4540 RETURN
  219. 4600 '@H
  220. 4610 D1$=LEFT$(DAT$,W-1)
  221. 4620 A$=MID$(STR$(B),2)
  222. 4630 W=INSTR(W,DAT$,A$)+LEN(A$)
  223. 4640 D2$=MID$(DAT$,W)
  224. 4650 DAT$=D1$+STR$(A(B))+D2$
  225. 4660 W=LEN(D1$+STR$(A(B)))+1
  226. 4670 RETURN
  227. 4680 '
  228. 4700 '-- GOTO GOSUB --    '@H
  229. 4710 GOSUB 4510
  230. 4720 IF B=0 THEN RETURN
  231. 4730 IF A(B)=0 THEN A(B)=B:ERF%=1:ERFF%=1
  232. 4740 GOSUB 4610:IF ERF%=1 THEN A(B)=0:ERF%=0
  233. 4750 W1=LEN(DAT$)
  234. 4760 IF W>W1 THEN 4800
  235. 4770 D2$=MID$(DAT$,W,1)
  236. 4780 IF D2$="," THEN W=W+1:GOF%=1:GOTO 4820
  237. 4790 IF D2$=" " THEN W=W+1:GOTO 4760
  238. 4800 RETURN
  239. 4810 '
  240. 4820 GOSUB 4520
  241. 4830 IF B=0 THEN 4800
  242. 4840 IF A(B)<>0 THEN 4740
  243. 4850 W=W+LEN(MID$(STR$(B),2))
  244. 4860 GOTO 4760
  245. 4870 '
  246. 4900 '-- THEN ELSE NEXT RETURN RESTORE RESUME --  '@H
  247. 4910 GOSUB 4510
  248. 4920 IF B=0 OR A(B)=0 THEN RETURN
  249. 4930 GOSUB 4610
  250. 4940 RETURN
  251. 4950 '
  252. 5000 '-- GOTO --                  '@H
  253. 5010 W=1:GOF%=0
  254. 5020 F=INSTR(W,DAT$,"GOTO")
  255. 5030 IF F=0 THEN 5050
  256. 5040 L=4:GOSUB 4710:GOTO 5020
  257. 5050 '-- GOSUB --
  258. 5060 W=1
  259. 5070 F=INSTR(W,DAT$,"GOSUB")
  260. 5080 IF F=0 THEN 5100
  261. 5090 L=5:GOSUB 4710:GOTO 5070
  262. 5100 '-- THEN --
  263. 5110 W=1
  264. 5120 F=INSTR(W,DAT$,"THEN")
  265. 5130 IF F=0 THEN 5150
  266. 5140 L=4:GOSUB 4910:GOTO 5120
  267. 5150 '-- ELSE --
  268. 5160 W=1
  269. 5170 F=INSTR(W,DAT$,"ELSE")
  270. 5180 IF F=0 THEN 5200
  271. 5190 L=4:GOSUB 4910:GOTO 5170
  272. 5200 '-- RETURN --
  273. 5210 W=1
  274. 5220 F=INSTR(W,DAT$,"RETURN")
  275. 5230 IF F=0 THEN 5250
  276. 5240 L=6:GOSUB 4910:GOTO 5220
  277. 5250 '-- RESTORE --
  278. 5260 W=1
  279. 5270 F=INSTR(W,DAT$,"RESTORE")
  280. 5280 IF F=0 THEN 5300
  281. 5290 L=7:GOSUB 4910:GOTO 5270
  282. 5300 '-- RESUME --
  283. 5310 W=1
  284. 5320 F=INSTR(W,DAT$,"RESUME")
  285. 5330 IF F=0 THEN 5350
  286. 5340 L=6:GOSUB 4910:GOTO 5320
  287. 5350 '--- GO. ---
  288. 5360 W=1
  289. 5370 F=INSTR(W,DAT$,"GO.")
  290. 5380 IF F=0 THEN 5400
  291. 5390 L=3:GOSUB 4710:GOTO 5370
  292. 5400 '-- GOS. --
  293. 5410 W=1
  294. 5420 F=INSTR(W,DAT$,"GOS.")
  295. 5430 IF F=0 THEN 5450
  296. 5440 L=4:GOSUB 4710:GOTO 5420
  297. 5450 '-- RET. --
  298. 5460 W=1
  299. 5470 F=INSTR(W,DAT$,"RET.")
  300. 5480 IF F=0 THEN 5500
  301. 5490 L=4:GOSUB 4910:GOTO 5470
  302. 5500 '-- RUN --
  303. 5510 W=1
  304. 5520 F=INSTR(W,DAT$,"RUN")
  305. 5530 IF F=0 THEN 5550
  306. 5540 L=3:GOSUB 4910:GOTO 5520
  307. 5550 '-- R. --
  308. 5560 W=1
  309. 5570 F=INSTR(W,DAT$,"R.")
  310. 5580 IF F=0 THEN 5700
  311. 5590 L=2:GOSUB 4910:GOTO 5570
  312. 5600 '
  313. 5700 ' 圧縮                   '@H
  314. 5710 IF GOF%=0 THEN RETURN
  315. 5720 W=INSTR(W,DAT$,", ")
  316. 5730 IF W=0 THEN RETURN
  317. 5740 '
  318. 5750 D1$=LEFT$(DAT$,W)
  319. 5760 D2$=MID$(DAT$,W+2)
  320. 5770 DAT$=D1$+D2$
  321. 5780 GOTO 5720
  322. 5790 '
  323.